home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Info / For Developers / GhostScript 5.10 / MacGS-510 / files / gs_init.ps < prev    next >
Text File  |  1997-11-04  |  46KB  |  1,459 lines
  1. %    Copyright (C) 1989, 1996, 1997 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This file is part of Aladdin Ghostscript.
  4. % 
  5. % Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
  6. % or distributor accepts any responsibility for the consequences of using it,
  7. % or for whether it serves any particular purpose or works at all, unless he
  8. % or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
  9. % License (the "License") for full details.
  10. % 
  11. % Every copy of Aladdin Ghostscript must include a copy of the License,
  12. % normally in a plain ASCII text file named PUBLIC.  The License grants you
  13. % the right to copy, modify and redistribute Aladdin Ghostscript, but only
  14. % under certain conditions described in the License.  Among other things, the
  15. % License requires that the copyright notice and this notice be preserved on
  16. % all copies.
  17.  
  18. % Initialization file for the interpreter.
  19. % When this is run, systemdict is still writable.
  20.  
  21. % Comment lines of the form
  22. %    %% Replace <n> <file(s)>
  23. % indicate places where the next <n> lines should be replaced by
  24. % the contents of <file(s)>, when creating a single merged init file.
  25.  
  26. % The interpreter can call out to PostScript code.  All procedures
  27. % called in this way, and no other procedures defined in these
  28. % initialization files, have names that begin with %, e.g.,
  29. % (%Type1BuildChar) cvn.
  30.  
  31. % Check the interpreter revision.  NOTE: the interpreter code requires
  32. % that the first non-comment token in this file be an integer.
  33. 510
  34. dup revision ne
  35.  { (gs: Interpreter revision \() print revision 10 string cvs print
  36.    (\) does not match gs_init.ps revision \() print 10 string cvs print
  37.    (\).\n) print flush null 1 .quit
  38.  }
  39. if pop
  40.  
  41. % Acquire userdict, and set its length if necessary.
  42. /userdict where
  43.  { pop userdict maxlength 0 eq }
  44.  { true }
  45. ifelse
  46.  {        % userdict wasn't already set up by iinit.c.
  47.    /userdict
  48.    currentdict dup 200 .setmaxlength        % userdict
  49.    systemdict begin def        % can't use 'put', userdict is local
  50.  }
  51.  { systemdict begin
  52.  }
  53. ifelse
  54.  
  55. % Define dummy local/global operators if needed.
  56. systemdict /.setglobal known
  57.  { true .setglobal
  58.  }
  59.  { /.setglobal { pop } bind def
  60.    /.currentglobal { false } bind def
  61.    /.gcheck { pop false } bind def
  62.  }
  63. ifelse
  64.  
  65. % Define .languagelevel if needed.
  66. systemdict /.languagelevel known not { /.languagelevel 1 def } if
  67.  
  68. % Optionally choose a default paper size other than U.S. letter.
  69. % (a4) /PAPERSIZE where { pop pop } { /PAPERSIZE exch def } ifelse
  70.  
  71. % Turn on array packing for the rest of initialization.
  72. true setpacking
  73.  
  74. % Define the old MS-DOS EOF character as a no-op.
  75. % This is a hack to get around the absurd habit of MS-DOS editors
  76. % of adding an EOF character at the end of the file.
  77. <1a> cvn { } def
  78.  
  79. % Acquire the debugging flags.
  80. currentdict /DEBUG known   /DEBUG exch def
  81.   /VMDEBUG
  82.     DEBUG {{print mark
  83.             systemdict /level2dict known
  84.          { .currentglobal dup false .setglobal vmstatus
  85.            true .setglobal vmstatus 3 -1 roll pop
  86.            6 -2 roll pop .setglobal
  87.          }
  88.          { vmstatus 3 -1 roll pop
  89.          }
  90.         ifelse usertime 16#fffff and counttomark
  91.           { ( ) print (           ) cvs print }
  92.         repeat pop
  93.         ( ) print systemdict length (    ) cvs print
  94.         ( ) print countdictstack (  ) cvs print
  95.         ( <) print count (  ) cvs print (>\n) print flush
  96.       }}
  97.       {{pop
  98.       }}
  99.      ifelse
  100.   def
  101.  
  102. currentdict /BATCH known   /BATCH exch def
  103. currentdict /DELAYBIND known   /DELAYBIND exch def
  104. currentdict /DISKFONTS known   /DISKFONTS exch def
  105. currentdict /ESTACKPRINT known   /ESTACKPRINT exch def
  106. currentdict /FAKEFONTS known   /FAKEFONTS exch def
  107. currentdict /FIXEDMEDIA known   /FIXEDMEDIA exch def
  108. currentdict /FIXEDRESOLUTION known   /FIXEDRESOLUTION exch def
  109. currentdict /LOCALFONTS known   /LOCALFONTS exch def
  110. currentdict /NOBIND known   /NOBIND exch def
  111. /.bind /bind load def
  112. NOBIND { /bind { } def } if
  113. currentdict /NOCACHE known   /NOCACHE exch def
  114. currentdict /NOCIE known   /NOCIE exch def
  115. currentdict /NODISPLAY known   not /DISPLAYING exch def
  116. currentdict /NOFONTMAP known   /NOFONTMAP exch def
  117. currentdict /NOFONTPATH known   /NOFONTPATH exch def
  118. currentdict /NOGC known   /NOGC exch def
  119. currentdict /NOPAUSE known   /NOPAUSE exch def
  120. currentdict /NOPLATFONTS known   /NOPLATFONTS exch def
  121. currentdict /NOPROMPT known   /NOPROMPT exch def
  122. % The default value of ORIENT1 is true, not false.
  123. currentdict /ORIENT1 known not { /ORIENT1 true def } if
  124. currentdict /OSTACKPRINT known   /OSTACKPRINT exch def
  125. currentdict /OUTPUTFILE known    % obsolete
  126.  { /OutputFile /OUTPUTFILE load def
  127.    currentdict /OUTPUTFILE .undef
  128.  } if
  129. currentdict /QUIET known   /QUIET exch def
  130. currentdict /SAFER known   /SAFER exch def
  131. currentdict /SHORTERRORS known   /SHORTERRORS exch def
  132. currentdict /WRITESYSTEMDICT known   /WRITESYSTEMDICT exch def
  133.  
  134. % Acquire environment variables.
  135. currentdict /DEVICE known not
  136.  { (GS_DEVICE) getenv { /DEVICE exch def } if } if
  137.  
  138. (START) VMDEBUG
  139.  
  140. % Open the standard files, so they will be open at the outermost save level.
  141. (%stdin) (r) file pop
  142. (%stdout) (w) file pop
  143. (%stderr) (w) file pop
  144.  
  145. % Define a procedure for skipping over an unneeded section of code.
  146. % This avoids allocating space for the skipped procedures.
  147. % We can't use readline, because that imposes a line length limit.
  148. /.skipeof    % <string> .skipeof -
  149.  { currentfile exch 1 exch .subfiledecode flushfile
  150.  } bind def
  151.  
  152. % If we're delaying binding, remember everything that needs to be bound later.
  153. DELAYBIND NOBIND not and
  154.  { .currentglobal false .setglobal
  155.    userdict /.delaybind 1500 array put
  156.    .setglobal
  157.    userdict /.delaycount 0 put
  158.     % When we've done the delayed bind, we want to stop saving.
  159.     % Detect this by the disappearance of .delaybind.
  160.    /bind
  161.     { userdict /.delaybind .knownget
  162.        { .delaycount 2 index put
  163.          userdict /.delaycount .delaycount 1 add put
  164.        }
  165.        { .bind
  166.        }
  167.       ifelse
  168.     } bind def
  169.  } if
  170.  
  171. % Define procedures to assist users who don't read the documentation.
  172. userdict begin
  173. /help
  174.  { (Enter PostScript commands.  '(filename) run' runs a file, 'quit' exits.\n)
  175.    print flush
  176.  } bind def
  177. /? /help load def
  178. end
  179.  
  180. % Define =string, which is used by some PostScript programs even though
  181. % it isn't documented anywhere.
  182. % Put it in userdict so that each context can have its own copy.
  183. userdict /=string 256 string put
  184.  
  185. % Print the greeting.
  186.  
  187. /printgreeting
  188.  { mark
  189.    product (Ghostscript) search
  190.     { pop pop pop
  191.       (This software comes with NO WARRANTY: see the file PUBLIC for details.\n)
  192.     }
  193.     { pop
  194.     }
  195.    ifelse
  196.    (\n) copyright
  197.    (\)\n) revisiondate 100 mod (-)
  198.    revisiondate 100 idiv 100 mod (-)
  199.    revisiondate 10000 idiv ( \()
  200.    revision 10 mod
  201.    revision 100 mod dup 0 ne { 10 idiv } { pop } ifelse (.)
  202.    revision 100 idiv ( )
  203.    product
  204.    counttomark
  205.     { (%stdout) (w) file exch false .writecvp
  206.     } repeat pop
  207.  } bind def
  208.  
  209. QUIET not { printgreeting flush } if
  210.  
  211. % Define a special version of def for making operator procedures.
  212. /odef        % <name> <proc> odef -
  213.  { 1 index exch .makeoperator def
  214.  } .bind def
  215.  
  216. %**************** BACKWARD COMPATIBILITY
  217. /getdeviceprops
  218.  { null .getdeviceparams
  219.  } bind odef
  220. /.putdeviceprops
  221.  { null true counttomark 1 add 3 roll .putdeviceparams
  222.    dup type /booleantype ne
  223.     { dup mark eq { /unknown /rangecheck } if
  224.       counttomark 4 add 1 roll cleartomark pop pop pop
  225.       /.putdeviceprops load exch signalerror
  226.     }
  227.    if
  228.  } bind odef
  229. /max { .max } bind def
  230. /min { .min } bind def
  231. /.currentfilladjust { .currentfilladjust2 pop } bind odef
  232. /.setfilladjust { dup .setfilladjust2 } bind odef
  233. /.writecvs { false .writecvp } bind odef
  234.  
  235. % Define predefined procedures substituting for operators,
  236. % in alphabetical order.
  237.  
  238. userdict /#copies 1 put
  239. % Adobe implementations don't accept /[ or /], so we don't either.
  240. ([) cvn
  241.     /mark load def
  242. (]) cvn
  243.     {counttomark array astore exch pop} odef
  244. /abs    {dup 0 lt {neg} if} odef
  245. % .beginpage is redefined if setpagedevice is present.
  246. /.beginpage { } odef
  247. /copypage
  248.     { 1 .endpage
  249.        { .currentnumcopies false .outputpage
  250.          (>>copypage, press <return> to continue<<\n) .confirm
  251.        }
  252.       if .beginpage
  253.     } odef
  254. /countexecstack { false .countexecstack } odef
  255. % .currentnumcopies is redefined in Level 2.
  256. /.currentnumcopies { #copies } odef
  257. /setcolorscreen where { pop        % not in all Level 1 configurations
  258.    /currentcolorscreen
  259.     { .currenthalftone
  260.        { { 60 exch 0 exch 3 copy 6 copy }    % halftone - not possible
  261.          { 3 copy 6 copy }            % screen
  262.          { }                % colorscreen
  263.        }
  264.       exch get exec
  265.     } odef
  266. } if
  267. /currentscreen
  268.     { .currenthalftone
  269.        { { 60 exch 0 exch }            % halftone - not possible
  270.          { }                % screen
  271.          { 12 3 roll 9 { pop } repeat }    % colorscreen
  272.        }
  273.       exch get exec
  274.     } odef
  275. /.echo /echo load def
  276. userdict /.echo.mode true put
  277. /echo    {dup /.echo.mode exch store .echo} odef
  278. /eexec
  279.     { 55665 //filterdict /eexecDecode get exec
  280.       cvx //systemdict begin exec
  281.         % Only pop systemdict if it is still the top element,
  282.         % because this is apparently what Adobe interpreters do.
  283.       currentdict //systemdict eq { end } if
  284.     } odef
  285. % .endpage is redefined if setpagedevice is present.
  286. /.endpage { 2 ne } odef
  287. % erasepage mustn't use gsave/grestore, because we call it before
  288. % the graphics state stack has been fully initialized.
  289. /erasepage
  290.     { /currentcolor where
  291.        { pop currentcolor currentcolorspace { setcolorspace setcolor } }
  292.        { /currentcmykcolor where
  293.           { pop currentcmykcolor { setcmykcolor } }
  294.           { currentrgbcolor { setrgbcolor } }
  295.          ifelse
  296.        }
  297.       ifelse 1 setgray .fillpage exec
  298.     } odef
  299. /execstack { false .execstack } odef
  300. /executive
  301.     { { prompt
  302.          { (%statementedit) (r) file } stopped
  303.          { pop pop $error /errorname get /undefinedfilename eq
  304.         { .clearerror exit } if        % EOF
  305.            handleerror null        % ioerror??
  306.          }
  307.         if
  308.         cvx { .runexec } execute
  309.       } loop
  310.     } odef
  311. /filter
  312.     { //filterdict 1 index .knownget
  313.        { exch pop exec }
  314.        { /filter load /undefined signalerror }
  315.       ifelse
  316.     } odef
  317. /handleerror
  318.     { //systemdict /errordict get /handleerror get exec } bind def
  319. /identmatrix [1.0 0.0 0.0 1.0 0.0 0.0] readonly def
  320. /identmatrix
  321.     { dup 0 //identmatrix putinterval } odef
  322. /languagelevel 1 def        % gs_lev2.ps may change this
  323. /makeimagedevice { false makewordimagedevice } odef
  324. /matrix    { 6 array identmatrix } odef
  325. /pathbbox
  326.     { false .pathbbox
  327.     } odef
  328. /prompt    { flush flushpage
  329.       (GS) print
  330.       count 0 ne { (<) print count =only } if
  331.       (>) print flush
  332.     } bind def
  333. /pstack    { 0 1 count 3 sub { index == } for } bind def
  334. /putdeviceprops
  335.     { .putdeviceprops { erasepage } if } odef
  336. /quit    { /quit load 0 .quit } odef
  337. /run    { dup type /filetype ne { (r) file } if
  338.         % We must close the file when execution terminates,
  339.         % regardless of the state of the stack,
  340.         % and then propagate an error, if any.
  341.       cvx .runexec
  342.     } odef
  343. % Execute a file.
  344. % Level 2 uses 2 .stop to clear the e-stack for a successful startjob:
  345. % we detect that here, since we need to handle this even if we start out
  346. % without job control in effect.
  347. %
  348. % What we push on the e-stack is the following to be executed in this order:
  349. %    <lit-file|fileproc> .runexec1 <lit-file|fileproc> .runexec2
  350. /.runexec1 {        % <file|fileproc> .runexec1 -
  351.   dup type /filetype ne { cvx exec } if
  352.   cvx null 2 .stopped
  353.     % If we got back here from a startjob, just keep going.
  354.     % startjob replaces the null on the o-stack with a procedure
  355.     % to be executed when we get back here.
  356.   dup null ne { exec true } { pop false } ifelse
  357. } bind def
  358. /.runexec2 {        % <continue> <file|fileproc> .runexec2 -
  359.   exch {
  360.     .runexec
  361.   } {
  362.     dup type /filetype ne { cvx exec } if
  363.     closefile
  364.   } ifelse
  365. } bind def
  366. /.runexec {        % <file|fileproc> .runexec -
  367.   cvlit /.runexec1 cvx 1 index /.runexec2 cvx 4 .execn
  368. } bind def
  369. % The following is only for compatibility with Adobe interpreters.
  370. /setdash {
  371.     1 index length 11 gt { /setdash load /limitcheck signalerror } if
  372.     //setdash
  373. } odef
  374. /setdevice
  375.     { .setdevice { erasepage } if } odef
  376. /setlinecap {
  377.     dup 2 gt { /setlinecap load /rangecheck signalerror } if
  378.     .setlinecap
  379. } odef
  380. /setlinejoin {
  381.     dup 2 gt { /setlinejoin load /rangecheck signalerror } if
  382.     .setlinejoin
  383. } odef
  384. /showpage
  385.     { 0 .endpage .doneshowpage
  386.        { .currentnumcopies true .outputpage
  387.          (>>showpage, press <return> to continue<<\n) .confirm
  388.          erasepage
  389.        }
  390.       if initgraphics .beginpage
  391.     } odef
  392. % Code output by Adobe Illustrator relies on the fact that
  393. % `stack' is a procedure, not an operator!!!
  394. /stack    { 0 1 count 3 sub { index = } for } bind def
  395. /start    { BATCH { null 0 .quit } { executive } ifelse } def
  396. % Internal uses of stopped that aren't going to do a stop if an error occurs
  397. % should use .internalstopped to avoid setting newerror et al.
  398. /.internalstopped { null 1 .stopped null ne } bind def
  399. /store    {    % Don't alter operands before completing.
  400.       1 index where { 2 index 2 index put pop pop } { def } ifelse
  401.     } odef
  402. % When running in Level 1 mode, this interpreter is supposed to be
  403. % compatible with PostScript "version" 54.0 (I think).
  404. /version (54.0) def
  405.  
  406. % internaldict is defined in systemdict, but is allocated in local VM.
  407. systemdict /internaldict .knownget not { 0 } if type /operatortype ne
  408.  { .currentglobal false .setglobal
  409.    //systemdict /internaldict known not { /internaldict 5 dict def } if
  410.    /internaldict
  411.     [ /dup load 1183615869 /eq load
  412.        [ /pop load internaldict ] cvx
  413.        [ /internaldict /cvx load /invalidaccess /signalerror cvx ] cvx
  414.       /ifelse load
  415.     ] cvx bind odef
  416.    .setglobal
  417.  } if
  418.  
  419. % Define some additional built-in procedures (beyond the ones defined by
  420. % the PostScript Language Reference Manual).
  421. % Warning: these are not guaranteed to stay the same from one release
  422. % to the next!
  423. /concatstrings
  424.     { exch dup length 2 index length add string    % str2 str1 new
  425.       dup dup 4 2 roll copy        % str2 new new new1
  426.       length 4 -1 roll putinterval
  427.     } bind def
  428. /copyarray
  429.     { dup length array copy } bind def
  430. % Copy a dictionary per the Level 2 spec even in Level 1.
  431. /.copydict        % <fromdict> <todict> .copydict <todict>
  432.     { dup 3 -1 roll { put dup } forall pop } bind def
  433. /copystring
  434.     { dup length string copy } bind def
  435. /finddevice
  436.     { //systemdict /devicedict get exch get
  437.       dup 1 get null eq
  438.        {        % This is the first request for this type of device.
  439.             % Create a default instance now.
  440.             % Stack: [proto null]
  441.          .currentglobal true .setglobal exch
  442.          dup dup 0 get copydevice 1 exch put
  443.          exch .setglobal
  444.        }
  445.       if 1 get
  446.     } bind def
  447. /.growdictlength    % get size for growing a dictionary
  448.     { length 3 mul 2 idiv 1 add
  449.     } bind def
  450. /.growdict        % grow a dictionary
  451.     { dup .growdictlength .setmaxlength
  452.     } bind def
  453. /.growput        % put, grow the dictionary if needed
  454.     { 2 index length 3 index maxlength eq
  455.        { 3 copy pop known not { 2 index .growdict } if
  456.        } if
  457.       put
  458.     } bind def
  459. /.packtomark
  460.     { counttomark packedarray exch pop } bind def
  461. /ppstack
  462.     { 0 1 count 3 sub { index === } for } bind def
  463. /runlibfile
  464.     {        % We don't want to bind 'run' into this procedure,
  465.             % since run may get redefined.
  466.       findlibfile
  467.        { exch pop //systemdict /run get exec }
  468.        { /undefinedfilename signalerror }
  469.       ifelse
  470.     } bind def
  471. /selectdevice
  472.     { finddevice setdevice .setdefaultscreen } bind def
  473. /signalerror        % <object> <errorname> signalerror -
  474.     { //systemdict /errordict get exch get exec } bind def
  475.  
  476. % Define the =[only] procedures.  Also define =print,
  477. % which is used by some PostScript programs even though
  478. % it isn't documented anywhere.
  479. /write=only {
  480.     .writecvs
  481. } bind def
  482. /write= {
  483.     1 index exch write=only (\n) writestring
  484. } bind def
  485. /=only    { (%stdout) (w) file exch write=only } bind def
  486. /=    { =only (\n) print } bind def
  487. /=print    /=only load def
  488. % Temporarily define == as = for the sake of runlibfile0.
  489. /== /= load def
  490.  
  491. % Define procedures for getting and setting the current device resolution.
  492.  
  493. /gsgetdeviceprop    % <device> <propname> gsgetdeviceprop <value>
  494.  { 2 copy mark exch null .dicttomark .getdeviceparams
  495.    dup mark eq        % if true, not found
  496.     { pop dup /undefined signalerror }
  497.     { 5 1 roll pop pop pop pop }
  498.    ifelse
  499.  } bind def
  500. /gscurrentresolution    % - gscurrentresolution <[xres yres]>
  501.  { currentdevice /HWResolution gsgetdeviceprop
  502.  } bind def
  503. /gssetresolution    % <[xres yres]> gssetresolution -
  504.  { 2 array astore mark exch /HWResolution exch
  505.    currentdevice copydevice putdeviceprops setdevice
  506.  } bind def
  507.  
  508. % Define auxiliary procedures needed for the above.
  509. /shellarguments        % -> shell_arguments true (or) false
  510.     { /ARGUMENTS where
  511.        { /ARGUMENTS get dup type /arraytype eq
  512.           { aload pop /ARGUMENTS null store true }
  513.           { pop false }
  514.          ifelse }
  515.        { false } ifelse
  516.     } bind def
  517. /.confirm
  518.     { DISPLAYING NOPAUSE not and
  519.        {    % Print a message (unless NOPROMPT is true)
  520.         % and wait for the user to type something.
  521.         % If the user just types a newline, flush it.
  522.          NOPROMPT { pop } { print flush } ifelse
  523.          .echo.mode false echo
  524.          (%stdin) (r) file dup read
  525.           { dup (\n) 0 get eq { pop pop } { unread } ifelse }
  526.           { pop }
  527.          ifelse echo
  528.        }
  529.        { pop
  530.        }
  531.       ifelse
  532.     } bind def
  533.  
  534. % Define the procedure used by .runfile, .runstdin and .runstring
  535. % for executing user input.
  536. % This is called with a procedure or executable file on the operand stack.
  537. /.execute {        % <obj> .execute <stopped>
  538.   stopped $error /newerror get and
  539.    { handleerror flush true } { false } ifelse
  540. } bind def
  541. /execute {        % <obj> execute -
  542.   .execute pop
  543. } odef
  544. % Define an execute analogue of runlibfile0.
  545. /execute0 {        % <obj> execute0 -
  546.   .execute { /execute0 cvx 1 .quit } if
  547. } bind def
  548. % Define the procedure that the C code uses for running files
  549. % named on the command line.
  550. /.runfile {
  551.   { runlibfile } execute
  552. } def
  553. % Define the procedure that the C code uses for running piped input.
  554. % We don't use the obvious { (%stdin) run }, because we want the file to be
  555. % reopened if a startjob does a restore.
  556. /.runstdin {
  557.   { { (%stdin) (r) file cvx } .runexec } execute0
  558. } bind def
  559. % Define the procedure that the C code uses for running commands
  560. % given on the command line with -c.  We turn the string into a file so that
  561. % .runexec can do the right thing with a startjob.
  562. /.runstring {
  563.   .currentglobal exch true .setglobal
  564.   0 () .subfiledecode
  565.   exch .setglobal cvx { .runexec } execute
  566. } bind def
  567. % Define the procedure that the C code uses to set up for executing
  568. % a string that may be received in pieces.
  569. /.runstringbegin {
  570.   .currentglobal true .setglobal
  571.   { .needinput } bind 0 () .subfiledecode
  572.   exch .setglobal cvx .runexec
  573. } bind def
  574.  
  575. % Define a special version of runlibfile that aborts on errors.
  576. /runlibfile0
  577.     { cvlit dup /.currentfilename exch def
  578.        { findlibfile not { stop } if }
  579.       stopped
  580.        { (Can't find \(or open\) initialization file ) print
  581.          .currentfilename == flush /runlibfile0 cvx 1 .quit
  582.        } if
  583.       exch pop cvx stopped
  584.        { (While reading ) print .currentfilename print (:\n) print flush
  585.          handleerror /runlibfile0 1 .quit
  586.        } if
  587.     } bind def
  588. % Temporarily substitute it for the real runlibfile.
  589. /.runlibfile /runlibfile load def
  590. /runlibfile /runlibfile0 load def
  591.  
  592. % Create the error handling machinery.
  593. % Define the standard error handlers.
  594. % The interpreter has created the ErrorNames array.
  595. /.unstoppederrorhandler    % <command> <errorname> .unstoppederrorhandler -
  596.  {    % This is the handler that gets used for recursive errors,
  597.     % or errors outside the scope of a 'stopped'.
  598.    2 copy SHORTERRORS
  599.     { (%%[ Error: ) print =only flush
  600.       (; OffendingCommand: ) print =only ( ]%%\n) print
  601.     }
  602.     { (Unrecoverable error: ) print =only flush
  603.       ( in ) print = flush
  604.       count 2 gt
  605.        { (Operand stack:\n  ) print
  606.      2 1 count 3 sub { (  ) print index =only flush } for
  607.      (\n) print flush
  608.        } if
  609.     }
  610.    ifelse
  611.    -1 0 1 //ErrorNames length 1 sub
  612.     { dup //ErrorNames exch get 3 index eq
  613.        { not exch pop exit } { pop } ifelse
  614.     }
  615.    for exch pop .quit
  616.  } bind def
  617. /.errorhandler        % <command> <errorname> .errorhandler -
  618.   {        % Detect an internal 'stopped'.
  619.     1 .instopped { null eq { pop pop stop } if } if
  620.     $error /.inerror get 1 .instopped { pop } { pop true } ifelse
  621.      { .unstoppederrorhandler
  622.      } if    % detect error recursion
  623.     $error /globalmode .currentglobal false .setglobal put
  624.     $error /.inerror true put
  625.     $error /newerror true put
  626.     $error exch /errorname exch put
  627.     $error exch /command exch put
  628.     $error /recordstacks get $error /errorname get /VMerror ne and
  629.      {        % Attempt to store the stack contents atomically.
  630.        count array astore dup $error /ostack 4 -1 roll
  631.        countexecstack array execstack $error /estack 3 -1 roll
  632.        countdictstack array dictstack $error /dstack 3 -1 roll
  633.        put put put aload pop
  634.      }
  635.      { $error /dstack .undef
  636.        $error /estack .undef
  637.        $error /ostack .undef
  638.      }
  639.     ifelse
  640.     $error /position currentfile status
  641.      { currentfile { fileposition } .internalstopped { pop null } if
  642.      }
  643.      {        % If this was a scanner error, the file is no longer current,
  644.         % but the command holds the file, which may still be open.
  645.        $error /command get dup type /filetype eq
  646.         { { fileposition } .internalstopped { pop null } if }
  647.         { pop null }
  648.        ifelse
  649.      }
  650.     ifelse put
  651.         % During initialization, we don't reset the allocation
  652.         % mode on errors.
  653.     $error /globalmode get $error /.nosetlocal get and .setglobal
  654.     $error /.inerror false put
  655.     stop
  656.   } bind def
  657. % Define the standard handleerror.  We break out the printing procedure
  658. % (.printerror) so that it can be extended for binary output
  659. % if the Level 2 facilities are present.
  660.   /.printerror
  661.    { $error begin
  662.        /command load errorname SHORTERRORS
  663.     { (%%[ Error: ) print =only flush
  664.       (; OffendingCommand: ) print =only
  665.       currentdict /errorinfo .knownget
  666.        { (;\nErrorInfo:) print
  667.          dup type /arraytype eq
  668.           { { ( ) print =only } forall }
  669.           { ( ) print =only }
  670.          ifelse
  671.        } if
  672.           ( ]%%\n) print flush
  673.     }
  674.     { (Error: ) print ==only flush
  675.       ( in ) print ==only flush
  676.       currentdict /errorinfo .knownget
  677.        { (\nAdditional information: ) print ==only flush
  678.        } if
  679.       .printerror_long
  680.     }
  681.        ifelse
  682.        .clearerror
  683.      end
  684.      flush
  685.     } bind def     
  686.   /.printerror_long            % long error printout,
  687.                     % $error is on the dict stack
  688.    {    % Push the (anonymous) stack printing procedure.
  689.     %  <heading> <==flag> <override-name> <stackname> proc
  690.        {
  691.      currentdict exch .knownget    % stackname defined in $error?
  692.      {
  693.        4 1 roll            % stack: <stack> <head> <==flag> <over>
  694.        errordict exch .knownget    % overridename defined?
  695.        { 
  696.          exch pop exch pop exec    % call override with <stack>
  697.        }
  698.        { 
  699.          exch print exch        % print heading. stack <==flag> <stack>
  700.          1 index not { (\n) print } if
  701.          { 1 index { (\n    ) } { (   ) } ifelse print
  702.            dup type /dicttype eq
  703.            {
  704.          (--dict:) print
  705.          dup rcheck
  706.           { dup length =only (/) print maxlength =only }
  707.           { pop }
  708.          ifelse
  709.          (--) print
  710.            }
  711.            {
  712.          dup type /stringtype eq 2 index or
  713.          { ===only } { =only } ifelse
  714.            } ifelse
  715.          } forall
  716.          pop
  717.        }
  718.        ifelse            % overridden
  719.      }
  720.      { pop pop pop
  721.      }
  722.      ifelse                % stack known
  723.        }
  724.  
  725.        (\nOperand stack:) OSTACKPRINT /.printostack /ostack 4 index exec
  726.        (\nExecution stack:) ESTACKPRINT /.printestack /estack 4 index exec
  727.        (\nBacktrace:) true /.printbacktrace /backtrace 4 index exec
  728.        (\nDictionary stack:) false /.printdstack /dstack 4 index exec
  729.        (\n) print
  730.        pop    % printing procedure
  731.  
  732.        errorname /VMerror eq
  733.     { (VM status:) print mark vmstatus
  734.       counttomark { ( ) print counttomark -1 roll dup =only } repeat
  735.       cleartomark (\n) print
  736.     } if
  737.  
  738.        .languagelevel 2 ge
  739.     { (Current allocation mode is ) print
  740.       globalmode { (global\n) } { (local\n) } ifelse print
  741.     } if
  742.  
  743.        .oserrno dup 0 ne
  744.     { (Last OS error: ) print
  745.       errorname /VMerror ne
  746.        { dup .oserrorstring { = pop } { = } ifelse }
  747.        { = }
  748.       ifelse
  749.     }
  750.     { pop
  751.     }
  752.        ifelse
  753.  
  754.        position null ne
  755.     { (Current file position is ) print position = }
  756.        if
  757.  
  758.    } bind def
  759. % Define a procedure for clearing the error indication.
  760. /.clearerror
  761.  { $error /newerror false put
  762.    $error /errorname null put
  763.    $error /errorinfo .undef
  764.    0 .setoserrno
  765.  } bind def
  766.  
  767. % Define $error.  This must be in local VM.
  768. .currentglobal false .setglobal
  769. /$error 40 dict def        % newerror, errorname, command, errorinfo,
  770.                 % ostack, estack, dstack, recordstacks,
  771.                 % binary, globalmode,
  772.                 % .inerror, .nosetlocal, position,
  773.         % plus extra space for badly designed error handers.
  774. $error begin
  775.   /newerror false def
  776.   /recordstacks true def
  777.   /binary false def
  778.   /globalmode .currentglobal def
  779.   /.inerror false def
  780.   /.nosetlocal true def
  781.   /position null def
  782. end
  783. % Define errordict similarly.  It has one entry per error name,
  784. %   plus handleerror.
  785. /errordict ErrorNames length 1 add dict def
  786. .setglobal        % contents of errordict are global
  787. errordict begin
  788.   ErrorNames
  789.    { mark 1 index systemdict /.errorhandler get /exec load .packtomark cvx def
  790.    } forall
  791. % The handlers for interrupt and timeout are special; there is no
  792. % 'current object', so they push their own name.
  793.    { /interrupt /timeout }
  794.    { mark 1 index dup systemdict /.errorhandler get /exec load .packtomark cvx def
  795.    } forall
  796. /handleerror
  797.  { //systemdict /.printerror get exec
  798.  } bind def
  799. end
  800.  
  801. % Define the [write]==[only] procedures.
  802. /.dict 26 dict dup
  803. begin def
  804.   /.cvp {1 index exch .writecvs} bind def
  805.   /.nop {exch pop .p} bind def
  806.   /.p {1 index exch writestring} bind def
  807.   /.p1 {2 index exch writestring} bind def
  808.   /.p2 {3 index exch writestring} bind def
  809.   /.print
  810.     { dup type .dict exch .knownget
  811.        { dup type /stringtype eq { .nop } { exec } ifelse }
  812.        { (-) .p1 type .cvp (-) .p }
  813.       ifelse
  814.     } bind def
  815.   /.pstring
  816.     {  { dup dup 32 lt exch 127 ge or
  817.           { (\\) .p1 2 copy -6 bitshift 48 add write
  818.         2 copy -3 bitshift 7 and 48 add write
  819.         7 and 48 add
  820.           }
  821.           { dup dup -2 and 40 eq exch 92 eq or {(\\) .p1} if
  822.           }
  823.          ifelse 1 index exch write
  824.        }
  825.       forall
  826.     } bind def  
  827.   /booleantype /.cvp load def
  828.   /conditiontype (-condition-) def
  829.   /devicetype (-device-) def
  830.   /dicttype (-dict-) def
  831.   /filetype (-file-) def
  832.   /fonttype (-fontID-) def
  833.   /gstatetype (-gstate-) def
  834.   /integertype /.cvp load def
  835.   /locktype (-lock-) def
  836.   /marktype (-mark-) def
  837.   /nulltype (null) def
  838.   /realtype {1 index exch true .writecvp} bind def
  839.   /savetype (-save-) def
  840.   /nametype
  841.     {dup xcheck not {(/) .p1} if
  842.      1 index exch .writecvs} bind def
  843.   /arraytype
  844.     {dup rcheck
  845.       {() exch dup xcheck
  846.         {({) .p2
  847.          {exch .p1
  848.           1 index exch .print pop ( )} forall
  849.          (})}
  850.         {([) .p2
  851.          {exch .p1
  852.           1 index exch .print pop ( )} forall
  853.          (])}
  854.        ifelse exch pop .p}
  855.       {(-array-) .nop}
  856.      ifelse} bind def
  857.   /operatortype
  858.       {(--) .p1 .cvp (--) .p} bind def
  859.   /packedarraytype
  860.     { dup rcheck
  861.        { arraytype }
  862.        { (-packedarray-) .nop }
  863.       ifelse
  864.     } bind def
  865.   /stringtype
  866.     { dup rcheck
  867.        { (\() .p1 dup length 200 le
  868.           { .pstring }
  869.           { 0 200 getinterval .pstring (...) .p }
  870.          ifelse (\)) .p
  871.        }
  872.        { (-string-) .nop
  873.        }
  874.       ifelse
  875.     } bind def
  876. {//.dict begin .print pop end}
  877.   bind
  878. end
  879.  
  880. /write==only exch def
  881. /write== {1 index exch write==only (\n) writestring} bind def
  882. /==only { (%stdout) (w) file exch write==only } bind def
  883. /== {==only (\n) print} bind def
  884.  
  885. % Define [write]===[only], an extension that prints dictionaries
  886. % in readable form and doesn't truncate strings.
  887. /.dict /write==only load 0 get dup length dict .copydict dup
  888. begin def
  889.   /dicttype
  890.     { dup rcheck
  891.        { (<< ) .p1
  892.           { 2 index 3 -1 roll .print pop ( ) .p1
  893.         1 index exch .print pop ( ) .p
  894.           }
  895.          forall (>>) .p
  896.        }
  897.        { (-dict-) .nop
  898.        }
  899.       ifelse
  900.     } bind def
  901.   /stringtype
  902.     { dup rcheck
  903.        { (\() .p1 .pstring (\)) .p }
  904.        { (-string-) .nop }
  905.       ifelse
  906.     } bind def
  907.  
  908. {//.dict begin .print pop end}
  909.   bind
  910. end
  911.  
  912. /write===only exch def
  913. /write=== {1 index exch write===only (\n) writestring} bind def
  914. /===only { (%stdout) (w) file exch write===only } bind def
  915. /=== { ===only (\n) print } bind def
  916.  
  917. (END PROCS) VMDEBUG
  918.  
  919. % Define the font directory.
  920. /FontDirectory false .setglobal 100 dict true .setglobal def
  921.  
  922. % Define the encoding dictionary.
  923. /EncodingDirectory 10 dict def    % enough for Level 2 + PDF standard encodings
  924.  
  925. % Define .findencoding.  (This is redefined in Level 2.)
  926. /.findencoding
  927.  { //EncodingDirectory exch get exec
  928.  } bind def
  929. /.defineencoding
  930.  { //EncodingDirectory 3 1 roll put
  931.  } bind def
  932. % If we've got the composite font extensions, define findencoding.
  933. /rootfont where { pop /findencoding { .findencoding } odef } if
  934.  
  935. % Load StandardEncoding.
  936. %% Replace 1 (gs_std_e.ps)
  937. (gs_std_e.ps) dup runlibfile VMDEBUG
  938.  
  939. % Load ISOLatin1Encoding.
  940. %% Replace 1 (gs_iso_e.ps)
  941. (gs_iso_e.ps) dup runlibfile VMDEBUG
  942.  
  943. % Define stubs for the Symbol and Dingbats encodings.
  944. % Note that the first element of the procedure must be the file name,
  945. % since gs_lev2.ps extracts it to set up the Encoding resource category.
  946.  
  947.   /SymbolEncoding { /SymbolEncoding .findencoding } bind def
  948. %% Replace 3 (gs_sym_e.ps)
  949.   EncodingDirectory /SymbolEncoding
  950.    { (gs_sym_e.ps) //systemdict begin runlibfile SymbolEncoding end }
  951.   bind put
  952.  
  953.   /DingbatsEncoding { /DingbatsEncoding .findencoding } bind def
  954. %% Replace 3 (gs_dbt_e.ps)
  955.   EncodingDirectory /DingbatsEncoding
  956.    { (gs_dbt_e.ps) //systemdict begin runlibfile DingbatsEncoding end }
  957.   bind put
  958.  
  959. (END FONTDIR/ENCS) VMDEBUG
  960.  
  961. % Construct a dictionary of all available devices.
  962. % These are (read-only) device prototypes that can't be
  963. % installed or have their parameters changed.  For this reason,
  964. % the value in the dictionary is actually a 2-element writable array,
  965. % to allow us to create a default instance of the prototype on demand.
  966.  
  967.     % Loop until the .getdevice gets a rangecheck.
  968. errordict /rangecheck 2 copy get
  969. errordict /rangecheck { pop stop } put    % pop the command
  970.   0 { {dup .getdevice exch 1 add} loop} .internalstopped pop
  971.   1 add dict  /devicedict 1 index def
  972.   begin            % 2nd copy of count is on stack
  973.    { dup .devicename exch
  974.      dup wcheck { dup } { null } ifelse 2 array astore def
  975.    } repeat
  976.   end
  977. put        % errordict /rangecheck
  978. .clearerror
  979. /devicenames devicedict { pop } forall devicedict length packedarray def
  980.  
  981. % Determine the default device.
  982. /defaultdevice DISPLAYING
  983.  { systemdict /DEVICE .knownget
  984.     { devicedict 1 index known not
  985.        { (Unknown device: ) print =
  986.      flush /defaultdevice cvx 1 .quit
  987.        }
  988.       if
  989.     }
  990.     { 0 .getdevice .devicename
  991.     }
  992.    ifelse
  993.  }
  994.  { /nullpage
  995.  }
  996. ifelse
  997. /.defaultdevicename 1 index def
  998. finddevice    % make a copy
  999. def
  1000. devicedict /Default devicedict .defaultdevicename get put
  1001.  
  1002. (END DEVS) VMDEBUG
  1003.  
  1004. % Define statusdict, for the benefit of programs
  1005. % that think they are running on a LaserWriter or similar printer.
  1006. %% Replace 1 (gs_statd.ps)
  1007. (gs_statd.ps) runlibfile
  1008.  
  1009. (END STATD) VMDEBUG
  1010.  
  1011. % Load the standard font environment.
  1012. %% Replace 1 (gs_fonts.ps)
  1013. (gs_fonts.ps) runlibfile
  1014.  
  1015. (END GS_FONTS) VMDEBUG
  1016.  
  1017. % Load the initialization files for optional features.
  1018. %% Replace 4 INITFILES
  1019. systemdict /INITFILES known
  1020.  { INITFILES { dup runlibfile VMDEBUG } forall
  1021.  }
  1022. if
  1023.  
  1024. % If Level 2 functionality is implemented, enable it now.
  1025. /.setlanguagelevel where
  1026.  { pop 2 .setlanguagelevel
  1027.     % If the resource machinery is loaded, fix up some things now.
  1028.    /.fixresources where { pop .fixresources } if
  1029.  } if
  1030.  
  1031. (END INITFILES) VMDEBUG
  1032.  
  1033. % Create a null font.  This is the initial font.
  1034. 8 dict dup begin
  1035.   /FontMatrix [ 1 0 0 1 0 0 ] readonly def
  1036.   /FontType 3 def
  1037.   /FontName () def
  1038.   /Encoding StandardEncoding def
  1039.   /FontBBox { 0 0 0 0 } readonly def % executable is bogus, but customary ...
  1040.   /BuildChar { pop pop 0 0 setcharwidth } bind def
  1041.   /PaintType 0 def        % shouldn't be needed!
  1042. end
  1043. /NullFont exch definefont setfont
  1044.  
  1045. % Define NullFont as the font.
  1046. /NullFont currentfont def
  1047.  
  1048. % Load initial fonts from FONTPATH directories, Fontmap file,
  1049. % and/or .getccfont as appropriate.
  1050. .loadinitialfonts
  1051.  
  1052. % Remove NullFont from FontDirectory, so it can't be accessed by mistake.
  1053. FontDirectory /NullFont .undef
  1054.  
  1055. (END FONTS) VMDEBUG
  1056.  
  1057. % Restore the real definition of runlibfile.
  1058. /runlibfile /.runlibfile load def
  1059. currentdict /.runlibfile .undef
  1060.  
  1061. % Bind all the operators defined as procedures.
  1062. /.bindoperators        % binds operators in currentdict
  1063.  { % Temporarily disable the typecheck error.
  1064.    errordict /typecheck 2 copy get
  1065.    errordict /typecheck { pop } put    % pop the command
  1066.    currentdict
  1067.     { dup type /operatortype eq
  1068.        { % This might be a real operator, so bind might cause a typecheck,
  1069.      % but we've made the error a no-op temporarily.
  1070.      .bind        % do a real bind even if NOBIND is set
  1071.        }
  1072.       if pop pop
  1073.     } forall
  1074.    put
  1075.  } def
  1076. NOBIND DELAYBIND or not { .bindoperators } if
  1077.  
  1078. % Establish a default environment.
  1079.  
  1080. defaultdevice
  1081. DISPLAYING not { setdevice (%END DISPLAYING) .skipeof } if
  1082. systemdict /DEVICEWIDTH known
  1083. systemdict /DEVICEHEIGHT known or
  1084. systemdict /DEVICEWIDTHPOINTS known or
  1085. systemdict /DEVICEHEIGHTPOINTS known or
  1086. systemdict /DEVICEXRESOLUTION known or
  1087. systemdict /DEVICEYRESOLUTION known or
  1088. systemdict /PAPERSIZE known or
  1089. not { (%END DEVICE) .skipeof } if
  1090. % Let DEVICE{WIDTH,HEIGHT}[POINTS] override PAPERSIZE.
  1091. systemdict /PAPERSIZE known
  1092. systemdict /DEVICEWIDTH known not and
  1093. systemdict /DEVICEHEIGHT known not and
  1094. systemdict /DEVICEWIDTHPOINTS known not and
  1095. systemdict /DEVICEHEIGHTPOINTS known not and
  1096.  {    % Convert the paper size to device dimensions.
  1097.    true statusdict /.pagetypenames get
  1098.     { PAPERSIZE eq
  1099.        { PAPERSIZE load
  1100.          dup 0 get /DEVICEWIDTHPOINTS exch def
  1101.          1 get /DEVICEHEIGHTPOINTS exch def
  1102.          pop false exit
  1103.        }
  1104.       if
  1105.     }
  1106.    forall
  1107.     { (Unknown paper size: ) print PAPERSIZE ==only (.\n) print
  1108.     }
  1109.    if
  1110.  }
  1111. if
  1112. % Adjust the device parameters per the command line.
  1113. % It is possible to specify resolution, pixel size, and page size;
  1114. % since any two of these determine the third, conflicts are possible.
  1115. % We simply pass them to .setdeviceparams and let it sort things out.
  1116.    mark /HWResolution null /HWSize null /PageSize null .dicttomark
  1117.    .getdeviceparams .dicttomark begin
  1118.    mark
  1119.     % Check for resolution.
  1120.    /DEVICEXRESOLUTION where dup
  1121.     { exch pop HWResolution 0 DEVICEXRESOLUTION put }
  1122.    if
  1123.    /DEVICEYRESOLUTION where dup
  1124.     { exch pop HWResolution 1 DEVICEYRESOLUTION put }
  1125.    if
  1126.    or { /HWResolution HWResolution } if
  1127.     % Check for device sizes specified in pixels.
  1128.    /DEVICEWIDTH where dup
  1129.     { exch pop HWSize 0 DEVICEWIDTH put }
  1130.    if
  1131.    /DEVICEHEIGHT where dup
  1132.     { exch pop HWSize 1 DEVICEHEIGHT put }
  1133.    if
  1134.    or { /HWSize HWSize } if
  1135.     % Check for device sizes specified in points.
  1136.    /DEVICEWIDTHPOINTS where dup
  1137.     { exch pop PageSize 0 DEVICEWIDTHPOINTS put }
  1138.    if
  1139.    /DEVICEHEIGHTPOINTS where dup
  1140.     { exch pop PageSize 1 DEVICEHEIGHTPOINTS put }
  1141.    if
  1142.    or { /PageSize PageSize } if
  1143.     % Check whether any parameters were set.
  1144.    dup mark eq { pop } { defaultdevice putdeviceprops } ifelse
  1145.    end
  1146. %END DEVICE
  1147. % Set any device properties defined on the command line.
  1148. % If BufferSpace is defined but not MaxBitmap, set MaxBitmap to BufferSpace.
  1149. systemdict /BufferSpace known
  1150. systemdict /MaxBitmap known not and
  1151.  { systemdict /MaxBitmap BufferSpace put
  1152.  } if
  1153. dup getdeviceprops
  1154. counttomark 2 idiv
  1155.  { systemdict 2 index known
  1156.     { pop dup load counttomark 2 roll }
  1157.     { pop pop }
  1158.    ifelse
  1159.  } repeat
  1160. counttomark dup 0 ne
  1161.  { 2 add -1 roll putdeviceprops }
  1162.  { pop pop }
  1163. ifelse
  1164. setdevice        % does an erasepage
  1165. % If the media size is fixed, update the current page device dictionary.
  1166. FIXEDMEDIA
  1167. dup { pop systemdict /.currentpagedevice known } if
  1168. dup { pop .currentpagedevice exch pop } if
  1169. not { (%END MEDIA) .skipeof } if
  1170. currentpagedevice dup length dict .copydict
  1171. dup /Policies
  1172.     % Stack: <pagedevice> <pagedevice> /Policies
  1173. 1 index /InputAttributes
  1174. 2 copy get dup length dict .copydict
  1175.     % Stack: <pagedevice> <pagedevice> /Policies <pagedevice>
  1176.     %   /InputAttributes <inputattrs'>
  1177. dup 0 2 copy get dup length dict .copydict
  1178.     % Stack: <pagedevice> <pagedevice> /Policies <pagedevice>
  1179.     %   /InputAttributes <inputattrs'> <inputattrs'> 0 <attrs0'>
  1180. dup /PageSize 7 index /PageSize get
  1181. put                % PageSize in 0
  1182. put                % 0 in InputAttributes
  1183. put                % InputAttributes in pagedevice
  1184. % Also change the page size policy so we don't get an error.
  1185.     % Stack: <pagedevice> <pagedevice> /Policies
  1186. 2 copy get dup length dict .copydict
  1187.     % Stack: <pagedevice> <pagedevice> /Policies <policies'>
  1188. dup /PageSize 7 put        % PageSize in Policies
  1189. put                % Policies in pagedevice
  1190. .setpagedevice
  1191. %END MEDIA
  1192. %END DISPLAYING
  1193.  
  1194. (END DEVICE) VMDEBUG
  1195.  
  1196. % Establish a default upper limit in the character cache,
  1197. % namely, enough room for a 18-point character at the resolution
  1198. % of the default device, or for a character consuming 1% of the
  1199. % maximum cache size, whichever is larger.
  1200. mark
  1201.     % Compute limit based on character size.
  1202.   18 dup dtransform
  1203.   exch abs cvi 31 add 32 idiv 4 mul    % X raster
  1204.   exch abs cvi mul        % Y
  1205.     % Compute limit based on allocated space.
  1206.   cachestatus pop pop pop pop pop exch pop 0.01 mul cvi
  1207.   .max dup 10 idiv exch
  1208. setcacheparams
  1209. % Conditionally disable the character cache.
  1210. NOCACHE { 0 setcachelimit } if
  1211.  
  1212. (END CONFIG) VMDEBUG
  1213.  
  1214. % Establish an appropriate halftone screen and BG/UCR functions.
  1215. % We make this a procedure so we can call it again when switching devices.
  1216.  
  1217. % Use an ordered dither for low-resolution devices.
  1218. /.setloresscreen    % <dpi> .setloresscreen -
  1219.  {    % The following 'ordered dither' spot function was contributed by
  1220.     % Gregg Townsend.  Thanks, Gregg!
  1221.    16.001 div 0            % not 16: avoids rounding problems
  1222.     { 1 add 7.9999 mul cvi exch 1 add 7.9999 mul cvi 16 mul add <
  1223.     0E 8E 2E AE 06 86 26 A6 0C 8C 2C AC 04 84 24 A4
  1224.     CE 4E EE 6E C6 46 E6 66 CC 4C EC 6C C4 44 E4 64
  1225.     3E BE 1E 9E 36 B6 16 96 3C BC 1C 9C 34 B4 14 94
  1226.     FE 7E DE 5E F6 76 D6 56 FC 7C DC 5C F4 74 D4 54
  1227.     01 81 21 A1 09 89 29 A9 03 83 23 A3 0B 8B 2B AB
  1228.     C1 41 E1 61 C9 49 E9 69 C3 43 E3 63 CB 4B EB 6B
  1229.     31 B1 11 91 39 B9 19 99 33 B3 13 93 3B BB 1B 9B
  1230.     F1 71 D1 51 F9 79 D9 59 F3 73 D3 53 FB 7B DB 5B
  1231.     0D 8D 2D AD 05 85 25 A5 0F 8F 2F AF 07 87 27 A7
  1232.     CD 4D ED 6D C5 45 E5 65 CF 4F EF 6F C7 47 E7 67
  1233.     3D BD 1D 9D 35 B5 15 95 3F BF 1F 9F 37 B7 17 97
  1234.     FD 7D DD 5D F5 75 D5 55 FF 7F DF 5F F7 77 D7 57
  1235.     02 82 22 A2 0A 8A 2A AA 00 80 20 A0 08 88 28 A8
  1236.     C2 42 E2 62 CA 4A EA 6A C0 40 E0 60 C8 48 E8 68
  1237.     32 B2 12 92 3A BA 1A 9A 30 B0 10 90 38 B8 18 98
  1238.     F2 72 D2 52 FA 7A DA 5A F0 70 D0 50 F8 78 D8 58
  1239.      > exch get 256 div
  1240.     }
  1241.    bind
  1242.         % Use correct, per-plane screens for CMYK devices only.
  1243.    //systemdict /setcolorscreen known processcolors 4 eq and
  1244.     { 3 copy 6 copy setcolorscreen }
  1245.     { setscreen }
  1246.    ifelse
  1247.    0 array cvx settransfer    % Genoa CET won't accept a packed array!
  1248.    /setstrokeadjust where { pop true setstrokeadjust } if
  1249.  } bind def
  1250. % Use a 45-degree spot screen for high-resolution devices.
  1251. /.sethiresscreen    % <dpi> .sethiresscreen -
  1252.  {    % According to information published by Hewlett-Packard,
  1253.     % they use a 60 line screen on 300 DPI printers and
  1254.     % an 85 line screen on 600 DPI printers.
  1255.     % However, we use a 106 line screen, which produces smoother-
  1256.     % looking shades but fewer of them (32 vs. 50).
  1257.     % 46 was suggested as a good frequency value for printers
  1258.     % between 200 and 400 DPI, so we use it for lower resolutions.
  1259.     % Imagesetters need even higher frequency screens.
  1260.    //systemdict /DITHERPPI known
  1261.     { DITHERPPI
  1262.     }
  1263.     { dup cvi 100 idiv 15 .min
  1264.        {null 46 46 60 60 60 106 106 106 106 133 133 133 133 133 150}
  1265.       exch get
  1266.      }
  1267.    ifelse
  1268.    1 index 4.01 div .min    % at least a 4x4 cell
  1269.    45
  1270.     % The following screen algorithm is used by permission of the author.
  1271.     { 1 add 180 mul cos 1 0.08 add mul exch 2 add 180 mul cos 
  1272.       1 0.08 sub mul add 2 div % (C) 1989 Berthold K.P. Horn
  1273.     }
  1274.    bind
  1275.     % Determine whether we have lots of process colors.
  1276.     % If so, don't bother with color screening or gamma correction.
  1277.     % Also don't do gamma correction on very high-resolution devices.
  1278.     % (This should depend on dot gain, not resolution, but we don't
  1279.     % currently have a way to determine this.)
  1280.    currentdevice mark
  1281.      /RedValues 0 /GreenValues 0 /BlueValues 0 /GrayValues 0
  1282.    .dicttomark .getdeviceparams
  1283.    counttomark 2 idiv 1 sub { exch pop min } repeat
  1284.    exch pop exch pop 32 lt 4 index 800 lt and 5 1 roll
  1285.     % Stack: doscreen dpi freq angle proc
  1286.     % Ghostscript currently doesn't use correct, per-plane halftones
  1287.     % unless setcolorscreen has been executed.  Since these are
  1288.     % computationally much more expensive than binary halftones,
  1289.     % we check to make sure they are really warranted, i.e., we have
  1290.     % a high-resolution CMYK device (i.e., not a display) with
  1291.     % fewer than 5 bits per plane (i.e., not a true-color device).
  1292.    4 -1 roll 150 ge
  1293.     { /setcolorscreen where
  1294.        { pop //systemdict /COLORSCREEN known
  1295.       { COLORSCREEN }
  1296.       { 3 index }
  1297.      ifelse
  1298.      dup false ne
  1299.       { 4 1 roll 3 copy 6 copy 13 -1 roll
  1300.     % For really high-quality screening on printers, we need to
  1301.     % give each plane its own screen angle.  Unfortunately,
  1302.     % this currently has very large space and time costs.
  1303.         true eq        % true => different angles,
  1304.                 % 0 => same angles
  1305.          { { 45 90 15 75 } { 3 1 roll exch pop 12 3 roll } forall
  1306.          }
  1307.         if setcolorscreen
  1308.       }
  1309.       { pop setscreen    % false => single binary screen
  1310.       }
  1311.      ifelse
  1312.        }
  1313.        { setscreen        % setcolorscreen not known
  1314.        }
  1315.       ifelse
  1316.     }
  1317.     { setscreen            % not high resolution
  1318.     }
  1319.    ifelse
  1320.             % Stack: doscreen
  1321.     {    % Set the transfer function to lighten up the grays.
  1322.     % We correct at the high end so that very light grays
  1323.     % don't disappear completely if they darken <1 screen pixel.
  1324.     % Parameter values closer to 1 are better for devices with
  1325.     % less dot spreading; lower values are better with more spreading.
  1326.     % The value 0.8 is a compromise that will probably please no one!
  1327.     %
  1328.     % Because of a bug in FrameMaker, we have to accept operands
  1329.     % outside the valid range of [0..1].
  1330.       { dup dup 0.0 gt exch 1.0 lt and
  1331.      { 0.8 exp dup dup 0.9375 gt exch 0.999 lt and    % > 15/16
  1332.         { .currentscreenlevels 1 sub    % tweak to avoid boundary
  1333.           1 exch div 1 exch sub .min
  1334.         }
  1335.        if
  1336.      }
  1337.     if
  1338.       }
  1339.     }
  1340.     {    % Set the transfer function to the identity.
  1341.       0 array cvx        % Genoa CET won't accept a packed array!
  1342.     }
  1343.    ifelse settransfer
  1344.    /setstrokeadjust where { pop false setstrokeadjust } if
  1345.     % Increase fill adjustment so that we effectively use Adobe's
  1346.     % any-part-of-pixel rule.
  1347.    0.5 .setfilladjust
  1348.  } bind def
  1349. % Set the default screen and BG/UCR based on the device resolution and
  1350. % process color capability.
  1351. /.setdefaultbgucr systemdict /setblackgeneration known { {
  1352.   processcolors 1 eq { { } } { { pop 0.0 } } ifelse
  1353.   dup setblackgeneration setundercolorremoval
  1354. } } { {
  1355. } } ifelse bind def
  1356. /.setdefaultscreen
  1357.  {    % Compute min(|dpi x|,|dpi y|) as the definition of the resolution.
  1358.    72 72 matrix defaultmatrix dtransform abs exch abs .min
  1359.    dup 150 lt //systemdict /DITHERPPI known not and
  1360.     { .setloresscreen } { .sethiresscreen }
  1361.    ifelse .setdefaultbgucr
  1362.  } bind def
  1363. .setdefaultscreen
  1364. initgraphics
  1365.  
  1366. % The interpreter relies on there being at least 2 entries
  1367. % on the graphics stack.  Establish the second one now.
  1368. gsave
  1369.  
  1370. % Define some control sequences as no-ops.
  1371. % This is a hack to get around problems
  1372. % in some common PostScript-generating applications.
  1373. <04> cvn { } def        % Apple job separator
  1374. <0404> cvn { } def        % two of the same
  1375. <1b> cvn { } def        % MS Windows LaserJet 4 prologue
  1376.                 % (UEL = ESC %-12345X)
  1377. <1b45> cvn { } def        % PJL reset prologue (ESC E)
  1378. <1b451b> cvn { } def        % PJL reset epilogue (ESC E + UEL)
  1379. <041b> cvn { } def        % MS Windows LaserJet 4 epilogue (^D + UEL)
  1380. (\001M) cvn            % TBCP initiator
  1381.  { currentfile /TBCPDecode filter cvx exec
  1382.  } bind def
  1383. /@PJL                % H-P job control
  1384.  { currentfile //=string readline { pop } if
  1385.  } bind def
  1386.  
  1387. % If we want a "safer" system, disable some obvious ways to cause havoc.
  1388. SAFER not { (%END SAFER) .skipeof } if
  1389. /file
  1390.  { dup (r) eq 2 index (%pipe*) .stringmatch not and
  1391.    2 index (%std*) .stringmatch or
  1392.     { file }
  1393.     { /invalidfileaccess signalerror }
  1394.    ifelse
  1395.  } .bind odef
  1396. /renamefile { /invalidfileaccess signalerror } odef
  1397. /deletefile { /invalidfileaccess signalerror } odef
  1398. /putdeviceprops
  1399.  { counttomark
  1400.    dup 2 mod 0 eq { pop /rangecheck signalerror } if
  1401.    3 2 3 2 roll
  1402.     { dup index /OutputFile eq  
  1403.        { -2 roll 
  1404.          dup () ne { /putdeviceprops load /invalidfileaccess signalerror } if
  1405.          3 -1 roll
  1406.        }
  1407.        { pop
  1408.        }
  1409.       ifelse
  1410.     } for
  1411.    putdeviceprops
  1412.  } .bind odef
  1413.  
  1414. %END SAFER
  1415.  
  1416. % If we delayed binding, make it possible to do it later.
  1417. /.bindnow
  1418.  { //systemdict begin .bindoperators end
  1419.    % Temporarily disable the typecheck error.
  1420.    errordict /typecheck 2 copy get
  1421.    errordict /typecheck { pop } put    % pop the command
  1422.    0 1 .delaycount 1 sub { .delaybind exch get .bind pop } for
  1423.    userdict /.delaybind .undef        % reclaim the space
  1424.    userdict /.delaycount .undef
  1425.    put
  1426.  } .bind def
  1427.  
  1428. % Turn off array packing, since some PostScript code assumes that
  1429. % procedures are writable.
  1430. false setpacking
  1431.  
  1432. % Close up systemdict.
  1433. currentdict /.forceput .undef        % remove temptation
  1434. currentdict /filterdict .undef        % bound in where needed
  1435. end
  1436. WRITESYSTEMDICT not { systemdict readonly pop } if
  1437.  
  1438. (END INIT) VMDEBUG
  1439.  
  1440. % Since some badly-behaved files include extremely long procedures,
  1441. % or construct huge arrays on the operand stack, increase the operand
  1442. % stack size here.
  1443. /setuserparams where
  1444.  { pop mark /MaxOpStack 20000 .dicttomark setuserparams
  1445.  } if
  1446.  
  1447. % Establish local VM as the default.
  1448. false /setglobal where { pop setglobal } { .setglobal } ifelse
  1449. $error /.nosetlocal false put
  1450.  
  1451. % Clean up VM, and enable GC.
  1452. /vmreclaim where
  1453.  { pop NOGC not { 2 vmreclaim 0 vmreclaim } if
  1454.  } if
  1455.  
  1456. (END GC) VMDEBUG
  1457.  
  1458. % The interpreter will run the initial procedure (start).
  1459.